home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp.lbr / XLFIO.CQ / xlfio.c
Encoding:
C/C++ Source or Header  |  1985-06-03  |  4.9 KB  |  238 lines
  1.                           /* xlfio - xlisp file i/o */
  2.  
  3. #ifdef CI_86
  4. #include "a:stdio.h"
  5. #include "xlisp.h"
  6. #endif
  7.  
  8. #ifdef AZTEC
  9. #include "a:stdio.h"
  10. #include "xlisp.h"
  11. #endif
  12.  
  13. #ifdef unix
  14. #include <stdio.h>
  15. #include <xlisp.h>
  16. #endif
  17.  
  18.  
  19.                             /* external variables */
  20.  
  21. extern struct node *xlstack;
  22.  
  23.  
  24.                               /* local variables */
  25.  
  26. static char buf[STRMAX+1];
  27.  
  28.  
  29.                            /**************************
  30.                            *  xlfopen - open a file  *
  31.                            **************************/
  32.  
  33. static struct node *xlfopen(args)
  34.   struct node *args;
  35. {
  36.     struct node *oldstk,arg,fname,mode,*val;
  37.     FILE *fp;
  38.  
  39.     oldstk = xlsave(&arg,&fname,&mode,NULL);
  40.     arg.n_ptr = args;
  41.  
  42.     fname.n_ptr = xlevmatch(STR,&arg.n_ptr);
  43.     mode.n_ptr = xlevmatch(STR,&arg.n_ptr);
  44.  
  45.     xllastarg(arg.n_ptr);
  46.  
  47.     if ((fp = fopen(fname.n_ptr->n_str,
  48.                         mode.n_ptr->n_str)) != NULL)
  49.     {
  50.         val = newnode(FPTR);
  51.         val->n_fp = fp;
  52.     }
  53.     else
  54.         val = NULL;
  55.  
  56.     xlstack = oldstk;
  57.     return (val);
  58. }
  59.  
  60.  
  61.                           /****************************
  62.                           *  xlfclose - close a file  *
  63.                           ****************************/
  64.  
  65. static struct node *xlfclose(args)
  66.   struct node *args;
  67. {
  68.     struct node *fptr;
  69.  
  70.     fptr = xlevmatch(FPTR,&args);
  71.  
  72.     xllastarg(args);
  73.  
  74.     if (fptr->n_fp == NULL)
  75.         xlfail("file not open");
  76.  
  77.     fclose(fptr->n_fp);
  78.     fptr->n_fp = NULL;
  79.  
  80.     return (NULL);
  81. }
  82.  
  83.  
  84.                    /*****************************************
  85.                    *  xlgetc - get a character from a file  *
  86.                    *****************************************/
  87.  
  88. static struct node *xlgetc(args)
  89.   struct node *args;
  90. {
  91.     struct node *val;
  92.     FILE *fp;
  93.     int ch;
  94.  
  95.     if (args != NULL)
  96.         fp = xlevmatch(FPTR,&args)->n_fp;
  97.     else
  98.         fp = stdin;
  99.  
  100.     xllastarg(args);
  101.  
  102.     if (fp == NULL)
  103.         xlfail("file not open");
  104.  
  105.     if ((ch = getc(fp)) != EOF)
  106.     {
  107.         val = newnode(INT);
  108.         val->n_int = ch;
  109.     }
  110.     else
  111.         val = NULL;
  112.  
  113.     return (val);
  114. }
  115.  
  116.  
  117.                     /***************************************
  118.                     *  xlputc - put a character to a file  *
  119.                     ***************************************/
  120.  
  121. static struct node *xlputc(args)
  122.   struct node *args;
  123. {
  124.     struct node *oldstk,arg,chr;
  125.     FILE *fp;
  126.  
  127.     oldstk = xlsave(&arg,&chr,NULL);
  128.     arg.n_ptr = args;
  129.  
  130.     chr.n_ptr = xlevmatch(INT,&arg.n_ptr);
  131.  
  132.     if (arg.n_ptr != NULL)
  133.         fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
  134.     else
  135.         fp = stdout;
  136.  
  137.     xllastarg(arg.n_ptr);
  138.  
  139.     if (fp == NULL)
  140.         xlfail("file not open");
  141.  
  142.     putc(chr.n_ptr->n_int,fp);
  143.  
  144.     xlstack = oldstk;
  145.     return (chr.n_ptr);
  146. }
  147.  
  148.  
  149.                     /***************************************
  150.                     *  xlfgets - get a string from a file  *
  151.                     ***************************************/
  152.  
  153. static struct node *xlfgets(args)
  154.   struct node *args;
  155. {
  156.     struct node *str;
  157.     char *sptr;
  158.     FILE *fp;
  159.  
  160.     if (args != NULL)
  161.         fp = xlevmatch(FPTR,&args)->n_fp;
  162.     else
  163.         fp = stdin;
  164.  
  165.     xllastarg(args);
  166.  
  167.     if (fp == NULL)
  168.         xlfail("file not open");
  169.  
  170.     if (fgets(buf,STRMAX,fp) != NULL)
  171.     {
  172.         str = newnode(STR);
  173.         str->n_str = strsave(buf);
  174.  
  175.         while (buf[strlen(buf)-1] != '\n')
  176.         {
  177.             if (fgets(buf,STRMAX,fp) == NULL)
  178.                 break;
  179.             sptr = str->n_str;
  180.             str->n_str = stralloc(strlen(sptr) + strlen(buf));
  181.             strcpy(str->n_str,sptr);
  182.             strcat(buf);
  183.             strfree(sptr);
  184.         }
  185.     }
  186.     else
  187.         str = NULL;
  188.  
  189.     return (str);
  190. }
  191.  
  192.  
  193.                      /*************************************
  194.                      *  xlfputs - put a string to a file  *
  195.                      *************************************/
  196.  
  197. static struct node *xlfputs(args)
  198.   struct node *args;
  199. {
  200.     struct node *oldstk,arg,str;
  201.     FILE *fp;
  202.  
  203.     oldstk = xlsave(&arg,&str,NULL);
  204.     arg.n_ptr = args;
  205.  
  206.     str.n_ptr = xlevmatch(STR,&arg.n_ptr);
  207.  
  208.     if (arg.n_ptr != NULL)
  209.         fp = xlevmatch(FPTR,&arg.n_ptr)->n_fp;
  210.     else
  211.         fp = stdout;
  212.  
  213.     xllastarg(arg.n_ptr);
  214.  
  215.     if (fp == NULL)
  216.         xlfail("file not open");
  217.  
  218.     fputs(str.n_ptr->n_str,fp);
  219.  
  220.     xlstack = oldstk;
  221.     return (str.n_ptr);
  222. }
  223.  
  224.  
  225.                       /************************************
  226.                       *  xlfinit - initialize file stuff  *
  227.                       ************************************/
  228.  
  229. xlfinit()
  230. {
  231.     xlsubr("fopen",xlfopen);
  232.     xlsubr("fclose",xlfclose);
  233.     xlsubr("getc",xlgetc);
  234.     xlsubr("putc",xlputc);
  235.     xlsubr("fgets",xlfgets);
  236.     xlsubr("fputs",xlfputs);
  237. }
  238.